10 ' factoril.bas - FreeWare 2006 - eric f. tchong
20 GOTO 60 ' begin
30 SAVE "factoril.bas",A:LIST-60
40 GOTO 510 ' wait for key
50 GOTO 540 ' text
60 DIM A%(1156):DEFSTR M,Q:Q=MKI$(0)
70 M(1) ="Factorials displayed in a triangle"
80 M(2) ="Examples:"
90 M(3) ="7 12 18 32 59 81 105 132 228 265 284 304 367 389 435 483 508"
100 M(4) ="Do you need a diskfile: <y/n> ?"
110 CLS:LOCATE 2,1
120 FOR I=1 TO 4
130  GOSUB 50:IF I=3 THEN PRINT
140 NEXT:GOSUB 40:CLS
150 IF ASC(Q)=89 OR ASC(Q)=121 THEN CP=1 ELSE CP=0 ' CP = copy
160 IF CP THEN 170 ELSE 200
170 CLS:PRINT "Type a filename <12345678.txt> ? ";:LINE INPUT Z$
180 IF LEFT$(Z$,1)=" " THEN Z$=MID$(Z$,2):GOTO 180
190 OPEN "O",#1,Z$:CLS 
200 INPUT "Enter a whole number (0 - 508) ";N
210 IF N>508 THEN PRINT:GOTO 200
220 IF N=0 THEN CLOSE #1:PRINT:END
230 ' DG = digit,  CR = carry
240 DG=1:CR=0
250 A%(1)=1
260 FOR I=2 TO N
270  FOR J=1 TO DG
280   A%(J)=A%(J)*I+CR
290   CR=INT(A%(J)/10)
300   A%(J)=A%(J)-10*CR
310  NEXT
320  IF CR>0 THEN C=INT(CR/10):DG=DG+1:A%(DG)=CR-10*C:CR=C:GOTO 320
330  CR=0
340 NEXT
350 Z=N:L=1
360 E=INT(Z/10):IF E<>0 THEN L=L+1:Z=E:GOTO 360
370 PRINT RIGHT$(STR$(N),L);"!= ";:IF CP THEN PRINT #1,RIGHT$(STR$(N),L);"!= ";
380 FOR R=1 TO N
390  PRINT TAB(41-R);:IF CP THEN PRINT #1,TAB(41-R);
400  FOR C=1 TO 2*R-1
410   E=DG
420   PRINT RIGHT$(STR$(A%(E)),1);
430   IF CP THEN PRINT #1,RIGHT$(STR$(A%(E)),1);
440   DG=DG-1:IF DG=0 THEN 480
450  NEXT
460  PRINT
470 NEXT
480 PRINT:PRINT:IF CP THEN PRINT #1,:PRINT #1,
490 GOTO 200
500 ' wait for key
510 LSET Q=MKI$(0)
520 WHILE CVI(Q)=0:MID$(Q,1)=INKEY$:WEND:RETURN
530 ' text
540 T=(80-LEN(M(I)))/2:PRINT TAB(T) M(I):RETURN
